home *** CD-ROM | disk | FTP | other *** search
/ Technotools / Technotools (Chestnut CD-ROM)(1993).ISO / lang_c / cug231 / drive.c < prev    next >
Text File  |  1987-06-17  |  14KB  |  675 lines
  1. /*
  2.     Little Smalltalk
  3.         command parser
  4.  
  5.         timothy a. budd, 12/84
  6.  
  7. */
  8. /*
  9.     The source code for the Little Smalltalk System may be freely
  10.     copied provided that the source of all files is acknowledged
  11.     and that this condition is copied with each file.
  12.  
  13.     The Little Smalltalk System is distributed without responsibility
  14.     for the performance of the program and without any guarantee of
  15.     maintenance.
  16.  
  17.     All questions concerning Little Smalltalk should be addressed to:
  18.  
  19.         Professor Tim Budd
  20.         Department of Computer Science
  21.         Oregon State University
  22.         Corvallis, Oregon
  23.         97331
  24.         USA
  25. */
  26. # include <stdio.h>
  27. # include "object.h"
  28. # define DRIVECODE
  29. # include "drive.h"
  30. # include "cmds.h"
  31. # include "number.h"
  32. # include "symbol.h"
  33. # include "string.h"
  34. # include "byte.h"
  35. # include "interp.h"
  36. # include "primitive.h"
  37.  
  38. extern enum lextokens token, nextlex();
  39. extern int prntcmd;
  40. extern int inisstd;
  41. extern int started;
  42. extern char toktext[];
  43. extern char *lexptr;
  44. extern int line_grabber();
  45. extern tok_type t;
  46.  
  47. /* test_driver - see if the driver should be invoked */
  48. int test_driver(block)
  49. int block;    /* indicates wheter to use block or non-blocking input */
  50. {
  51.     switch(line_grabber( block )) {
  52.         default: cant_happen(17);
  53.         case -1:
  54.             /*  return end of file indication */
  55.             return(0);
  56.         case 0:
  57.             /* enqueue driver process again */
  58.             return(1);
  59.         case 1:
  60.             if (*lexptr == ')') {
  61.                 dolexcommand(lexptr);
  62.                 return(1);
  63.                 }
  64.             parse();
  65.             return(1);
  66.         }
  67. }
  68.  
  69. /* ---- code generation routines  -------------- */
  70. # define CODEMAX 500
  71. static uchar code[CODEMAX];
  72. static int codetop = 0;
  73.  
  74. static gencode(value)
  75. register int value;
  76. {
  77.     if (value >= 256)
  78.         lexerr("code word too big: %d", value);
  79.     if (codetop > CODEMAX)
  80.         lexerr("too many code words: %d", codetop);
  81.     /*if (started)
  82.     fprintf(stderr,"code %d (%d %d)\n", value, value/16, value%16);*/
  83.     code[codetop++] = itouc(value);
  84. }
  85.  
  86. static genhighlow(high, low)
  87. register int high;
  88. register int low;
  89. {
  90.     if (high < 0 || high > 16)
  91.         lexerr("genhighlow error: %d", high);
  92.     if (low < 0)
  93.         lexerr("genhighlow low error: %d", low);
  94.     if (low < 16) gencode(high * 16 + low);
  95.     else {
  96.         gencode(TWOBIT * 16 + high);
  97.         gencode(low);
  98.         }
  99. }
  100. /*-------------------------------------------------------*/
  101.  
  102. static int errflag;
  103.  
  104. /* parse - main parser */
  105. int parse()
  106. {    register int i;
  107.  
  108.     errflag = 0;
  109.     reset();
  110.  
  111.     if (nextlex() == nothing) return(1);
  112.     if (token == NL) return(1);
  113.  
  114.     i = aprimary();
  115.     if (i >= 0) {
  116.         asign(i);
  117.         if ((prntcmd > 1) && inisstd)
  118.             genhighlow(UNSEND, PRNTCMD);
  119.         }
  120.     else {
  121.         cexpression();
  122.         if (prntcmd && inisstd)
  123.             genhighlow(UNSEND, PRNTCMD);
  124.         }
  125.     genhighlow(POPINSTANCE, 0);    /* assign to ``last'' */
  126.     if (errflag)
  127.         return(1);
  128.     if (token == nothing || token == NL) {
  129.         bld_interpreter();
  130.         return(0);
  131.         }
  132.     expect("end of expression");
  133.     return(1);
  134. }
  135.  
  136. /* asign - code for an assignment statement - leaves result on stack */
  137. static asign(pos)
  138. int pos;
  139. {    int i;
  140.  
  141.     i = aprimary();
  142.     if (i >= 0) {
  143.         asign(i);
  144.         }
  145.     else {
  146.         cexpression();
  147.         }
  148.     genhighlow(SPECIAL, DUPSTACK);
  149.     genhighlow(POPINSTANCE, pos);
  150. }
  151.  
  152. /* expression - read an expression, leaving result on stack */
  153. static expression()
  154. {    int i;
  155.  
  156.     i = aprimary();
  157.     if (i >= 0) {
  158.         asign(i);
  159.         }
  160.     else {
  161.         cexpression();
  162.         }
  163. }
  164.  
  165. /* cexpression - code for a (possibly cascaded) expression */
  166. static cexpression()
  167. {
  168.     kcontinuation();
  169.     while (token == SEMI) {
  170.         genhighlow(SPECIAL, DUPSTACK);
  171.         nextlex();
  172.         kcontinuation();
  173.         genhighlow(SPECIAL, POPSTACK);
  174.         }
  175. }
  176.  
  177. /* kcontinuation - keyword continuation */
  178. static kcontinuation()
  179. {    char kbuf[150];
  180.     int  kcount;
  181.  
  182.     bcontinuation();
  183.     if (token == KEYWORD) {
  184.         kbuf[0] = '\0';
  185.         kcount = 0;
  186.         while (token == KEYWORD) {
  187.             strcat(kbuf, t.c);
  188.             strcat(kbuf, ":");
  189.             kcount++;
  190.             nextlex();
  191.             primary(1);
  192.             bcontinuation();
  193.             }
  194.         gensend(kbuf, kcount);
  195.         }
  196. }
  197.  
  198. /* isbinary - see if the current token(s) is a binary */
  199. static int isbinary(bbuf)
  200. char *bbuf;
  201. {
  202.     if (token == BINARY || token == MINUS ||
  203.         token == BAR || token == PE) {
  204.         strcpy(bbuf, t.c);
  205.         nextlex();
  206.         if (token == BINARY || token == MINUS ||
  207.                 token == BAR || token == PE) {
  208.             strcat(bbuf, t.c);
  209.             nextlex();
  210.             }
  211.         return(1);
  212.         }
  213.     return(0);
  214. }
  215.  
  216. /* bcontinuation - binary continuation */
  217. static bcontinuation()
  218. {    char bbuf[3];
  219.  
  220.     ucontinuation();
  221.     while (isbinary(bbuf)) {
  222.         primary(1);
  223.         ucontinuation();
  224.         gensend(bbuf, 1);
  225.         }
  226. }
  227.  
  228. /* ucontinuation - unary continuation */
  229. static ucontinuation()
  230. {
  231.     while (token == LOWERCASEVAR) {
  232.         gensend(t.c, 0);
  233.         nextlex();
  234.         }
  235. }
  236.  
  237. /* aprimary - primary or beginning of assignment */
  238. static int aprimary()
  239. {    char *c;
  240.  
  241.     if (token == LOWERCASEVAR) {
  242.         c = t.c;
  243.         if (nextlex() == ASSIGN) {
  244.             nextlex();
  245.             return(findvar(c, 1));
  246.             }
  247.         else {
  248.             genvar(c);
  249.             return( -1 );
  250.             }
  251.         }
  252.     primary(1);
  253.     return( - 1 );
  254. }
  255.  
  256. /* primary - find a primary expression */
  257. static int primary(must)
  258. int must;    /* must we find something ? */
  259. {    int i, count;
  260.  
  261.     switch(token) {
  262.         case UPPERCASEVAR:
  263.             genhighlow(PUSHCLASS, aliteral(1));
  264.             break;
  265.  
  266.         case LOWERCASEVAR:
  267.             genvar(t.c);
  268.             nextlex();
  269.             break;
  270.  
  271.         case LITNUM:
  272.             if (t.i >= 0 && t.i < 10) {
  273.                 genhighlow(PUSHSPECIAL, t.i);
  274.                 nextlex();
  275.                 }
  276.             else {
  277.                 genhighlow(PUSHLIT, aliteral(1));
  278.                 }
  279.             break;
  280.  
  281.         case MINUS:
  282.         case LITFNUM:
  283.         case LITCHAR:
  284.         case LITSTR:
  285.         case LITSYM:
  286.         case PS:
  287.             genhighlow(PUSHLIT, aliteral(1));
  288.             break;
  289.  
  290.         case PSEUDO:
  291.             switch(t.p) {
  292.                 case nilvar: i = 13; break;
  293.                 case truevar: i = 11; break;
  294.                 case falsevar: i = 12; break;
  295.                 case smallvar: i  = 14; break;
  296.                 default: lexerr("unknown pseudo var %d", t.p);
  297.                 }
  298.             genhighlow(PUSHSPECIAL, i);
  299.             nextlex();
  300.             break;
  301.  
  302.         case PRIMITIVE:
  303.             if (nextlex() != LITNUM) expect("primitive number");
  304.             i = t.i;
  305.             nextlex();
  306.             count = 0;
  307.             while (primary(0)) count++;
  308.             if (token != PE) expect("primitive end");
  309.             nextlex();
  310.             genhighlow(SPECIAL, PRIMCMD);
  311.             gencode(count);
  312.             gencode(i);
  313.             break;
  314.  
  315.         case LP:
  316.             nextlex();
  317.             expression();
  318.             if (token != RP) expect("right parenthesis");
  319.             nextlex();
  320.             break;
  321.  
  322.         case LB:
  323.             nextlex();
  324.             block();
  325.             break;
  326.  
  327.         default:
  328.             if (must) expect("primary expression");
  329.             return(0);
  330.         }
  331.     return(1);
  332. }
  333.  
  334. static int maxtemps = 1;
  335. static int temptop = 0;
  336. static char *tempnames[20];
  337.  
  338. /* block - parse a block definition */
  339. static block()
  340. {    int count, i, position;
  341.  
  342.     count = 0;
  343.     if (token == COLONVAR) {
  344.         while (token == COLONVAR) {
  345.             tempnames[temptop++] = t.c;
  346.             if (temptop > maxtemps) maxtemps = temptop;
  347.             count++;
  348.             nextlex();
  349.             }
  350.         if (token != BAR)
  351.             expect("bar following arguments in block");
  352.         nextlex();
  353.         }
  354.     genhighlow(BLOCKCREATE, count);
  355.     if (count)         /* where arguments go in context */
  356.         gencode(1 + (temptop - count));    
  357.     position = codetop;
  358.     gencode(0);
  359.  
  360.     if (token == RB) {
  361.         genhighlow(PUSHSPECIAL, 13);
  362.         }
  363.     else
  364.         while (1) {
  365.             i = aprimary();
  366.             if (i >= 0) {
  367.                 expression();
  368.                 if (token != PERIOD)
  369.                     genhighlow(SPECIAL, DUPSTACK);
  370.                 genhighlow(POPINSTANCE, i);
  371.                 }
  372.             else {
  373.                 cexpression();
  374.                 if (token == PERIOD)
  375.                     genhighlow(SPECIAL, POPSTACK);
  376.                 }
  377.             if (token != PERIOD)
  378.                 break;
  379.             nextlex();
  380.             }
  381.     genhighlow(SPECIAL, RETURN);
  382.     if (token != RB) expect("end of block");
  383.     temptop -= count;
  384.     nextlex();
  385.     i = (codetop - position) - 1;
  386.     if (i > 255)
  387.         lexerr("block too big %d", i);
  388.     code[position] = itouc(i);
  389. }
  390.  
  391. # define LITMAX 100
  392. static object *lit_array[LITMAX];
  393. static int littop = 0;
  394.  
  395. static int addliteral(lit)
  396. object *lit;
  397. {
  398.     if (littop >= LITMAX)
  399.         cant_happen(18);
  400.     sassign(lit_array[littop++], lit);
  401.     return(littop - 1);
  402. }
  403.  
  404. /* aliteral - find a literal that is part of a literal array */
  405. static int aliteral(must)
  406. int must;    /* must we find something ? */
  407. {    char *c;
  408.     object *new;
  409.     int count;
  410.     int bytetop;
  411.     uchar bytes[200];
  412.  
  413.     switch(token) {
  414.         case MINUS:
  415.             c = t.c;
  416.             nextlex();
  417.             if (token == LITNUM) {
  418.                 new = new_int( - t.i );
  419.                 nextlex();
  420.                 }
  421.             else if (token == LITFNUM) {
  422.                 new = new_float( - t.f );
  423.                 nextlex();
  424.                 }
  425.             else {
  426.                 new = new_sym(c);
  427.                 }
  428.             break;
  429.  
  430.         case LITNUM:
  431.             new = new_int(t.i);
  432.             nextlex();
  433.             break;
  434.  
  435.         case LITFNUM:
  436.             new = new_float(t.f);
  437.             nextlex();
  438.             break;
  439.  
  440.         case LITCHAR:
  441.             new = new_char(t.i);
  442.             nextlex();
  443.             break;
  444.  
  445.         case LITSTR:
  446.             new = new_str(t.c);
  447.             nextlex();
  448.             break;
  449.  
  450.         case LITSYM:
  451.             new = new_sym(t.c);
  452.             nextlex();
  453.             break;
  454.  
  455.         case PSEUDO:
  456.             switch(t.p) {
  457.                 case nilvar: new = o_nil; break;
  458.                 case truevar: new = o_true; break;
  459.                 case falsevar: new = o_false; break;
  460.                 case smallvar: new = o_smalltalk; break;
  461.                 default: lexerr("unknown peudo %d", t.p);
  462.                 }
  463.             nextlex();
  464.             break;
  465.  
  466.         case PS:
  467.             nextlex();
  468.             if (token == LP) goto rdarray;
  469.             else if (token == LB) {
  470.                 bytetop = 0;
  471.                 while (nextlex() == LITNUM)
  472.                     bytes[bytetop++] = itouc(t.i);
  473.                 if (token != RB)
  474.                     expect("right bracket");
  475.                 nextlex();
  476.                 new = new_bytearray(bytes, bytetop);
  477.                 }
  478.             else expect("array or bytearray");
  479.             break;
  480.  
  481.         case LP: rdarray:
  482.             count = 0;
  483.             nextlex();
  484.             while (aliteral(0) >= 0) {
  485.                 count++;
  486.                 }
  487.             if (token != RP) expect("right parenthesis");
  488.             nextlex();
  489.             new = new_array(count, 0);
  490.             while (count)
  491.                 new->inst_var[--count] = lit_array[--littop];
  492.             break;
  493.  
  494.         case UPPERCASEVAR:
  495.         case LOWERCASEVAR:
  496.         case KEYWORD:
  497.         case COLONVAR:
  498.         case BINARY:
  499.         case PE:
  500.         case BAR:
  501.         case SEMI:
  502.             new = new_sym(t.c);
  503.             nextlex();
  504.             break;
  505.  
  506.         default:
  507.             if (must)
  508.                 expect("literal");
  509.             else return( - 1 );
  510.         }
  511.     return(addliteral(new));
  512. }
  513.  
  514. /* gensend - generate a message send */
  515. static gensend(message, numargs)
  516. char *message;
  517. int  numargs;
  518. {    int i;
  519.     char **p, c;
  520.     tok_type e;
  521.  
  522.     c = *message;
  523.     if (numargs == 0) {
  524.         for (p = unspecial, i = 0; *p; i++, p++)
  525.             if ((**p == c) && (strcmp(*p, message) == 0)) {
  526.                 genhighlow(UNSEND, i);
  527.                 return;
  528.                 }
  529.         }
  530.     else if (numargs == 1) {
  531.         for (p = binspecial, i = 0; *p; i++, p++)
  532.             if ((**p == c) && (strcmp(*p, message) == 0)) {
  533.                 genhighlow(BINSEND, i);
  534.                 return;
  535.                 }
  536.         for (p = arithspecial, i = 0; *p; i++, p++)
  537.             if ((**p == c) && (strcmp(*p, message) == 0)) {
  538.                 genhighlow(ARITHSEND, i);
  539.                 return;
  540.                 }
  541.         }
  542.     else if (numargs == 2) {
  543.         for (p = keyspecial, i = 0; *p; i++, p++)
  544.             if ((**p == c) && (strcmp(*p, message) == 0)) {
  545.                 genhighlow(KEYSEND, i);
  546.                 return;
  547.                 }
  548.         }
  549.     genhighlow(SEND, numargs);
  550.     gencode(addliteral(new_sym(message)));
  551. }
  552.  
  553. static object *var_names;
  554. static object *var_values;
  555.  
  556. extern object *o_nil, *o_true;
  557.  
  558. static int findvar(str, make)
  559. char *str;
  560. int make;
  561. {  int i;
  562.    object *comp_obj;
  563.  
  564.    sassign(comp_obj, new_obj((class *) 0, 2, 0));
  565.    sassign(comp_obj->inst_var[0], o_nil);
  566.    sassign(comp_obj->inst_var[1], new_sym(str));
  567.    for (i = 0; i < var_names->size; i++) {
  568.     assign(comp_obj->inst_var[0], var_names->inst_var[i]);
  569.     if (o_true == primitive(SYMEQTEST, 2, &(comp_obj->inst_var[0]))) {
  570.         obj_dec(comp_obj);
  571.         return(i);
  572.         }
  573.     }
  574.    /* not found, perhaps it's new */
  575.    if (make) {
  576.     assign(comp_obj->inst_var[0], var_names);
  577.     assign(var_names, primitive(GROW, 2, &(comp_obj->inst_var[0])));
  578.     assign(comp_obj->inst_var[0], var_values);
  579.     assign(comp_obj->inst_var[1], o_nil);
  580.     assign(var_values, primitive(GROW, 2, &(comp_obj->inst_var[0])));
  581.     }
  582.    else {
  583.     lexerr("unknown variable %s", str);
  584.     i = 0;
  585.     }
  586.    obj_dec(comp_obj);
  587.    return(i);
  588. }
  589.  
  590. genvar(name)
  591. char *name;
  592. {    int i;
  593.  
  594.     for (i = 0; i < temptop; i++)
  595.         if (strcmp(name, tempnames[i]) == 0) {
  596.             genhighlow(PUSHTEMP, i+1);
  597.             return;
  598.             }
  599.     genhighlow(PUSHINSTANCE, findvar(name, 0));
  600. }
  601.  
  602. /* lexerr - error printing with limited reformatting */
  603. lexerr(s, v)
  604. char *s, *v;
  605. {
  606.     char e1[500], e2[500];
  607.     object *new;
  608.  
  609.     errflag = 1;
  610.     sprintf(e1, s, v); /* format error message */
  611.     sprintf(e2, "error: %s\n", e1);
  612.     sassign(new, new_str(e2));
  613.     primitive(ERRPRINT, 1, &new);
  614.     obj_dec(new);
  615. }
  616.  
  617. expect(str)
  618. char *str;
  619. {    char ebuf[150];
  620.  
  621.     /*fprintf(stderr,"expected %s\n", str);
  622.     fprintf(stderr,"current token type %d\n", token);
  623.     fprintf(stderr,"remainder of line %s\n", lexptr);
  624.     fprintf(stderr,"current text %s\n", toktext);*/
  625.     sprintf(ebuf,"expected %s found %s", str, toktext);
  626.     lexerr(ebuf,"");
  627. }
  628.  
  629. extern object *o_drive;    /* ``driver'' interpreter */
  630.  
  631. bld_interpreter()
  632. {  interpreter *interp;
  633.    object *literals, *bytecodes, *context;
  634.    int i;
  635.  
  636.    if (codetop == 0) {
  637.     return;
  638.     }
  639.    genhighlow(SPECIAL, SELFRETURN);
  640.    gencode(0);            /* mark end of bytecodes */
  641.    sassign(literals, new_array(littop, 0));
  642.    for (i = 0; i < littop; i++)
  643.     literals->inst_var[ i ] = lit_array[i];
  644.    sassign(bytecodes, new_bytearray(code, codetop));
  645.    sassign(context, new_obj((class *) 0, 1 + maxtemps, 1));
  646.    interp = cr_interpreter((interpreter *) o_drive, var_values,
  647.         literals, bytecodes, context);
  648.    link_to_process(interp);
  649.    obj_dec(context);
  650.    obj_dec(bytecodes);
  651.    obj_dec(literals);
  652. }
  653.  
  654. reset(){
  655.     codetop = littop = temptop = 0;
  656.     maxtemps = 1;
  657. }
  658.  
  659. /* drv_init initializes the driver, should be called only once */
  660. drv_init() {
  661.     sassign(var_names, new_obj((class *) 0, 0, 0));
  662.     sassign(var_values, new_obj((class *) 0, 0, 0));
  663.     reset();
  664.     findvar("last", 1);     /* create variable "last" */
  665.     }
  666.  
  667. drv_free() {
  668.     int i;
  669.  
  670.     for (i = 0; i < var_values->size; i++)
  671.         assign(var_values->inst_var[ i ], o_nil);
  672.     obj_dec(var_names);
  673.     obj_dec(var_values);
  674.     }
  675.